home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / music / musgfa.zoo / musex1.lst < prev    next >
File List  |  1992-12-24  |  18KB  |  854 lines
  1. ' musicex1  learn how to play piano / Nov 1 1992
  2. ' Seymour Shlien/ 624 Courtenay Avenue/ Ottawa/ K2A 3B5 Canada
  3. ' public domain
  4. ' programmed in GFA basic 3.5
  5. REM BBR% position of black bars
  6. REM WKYCOD%  white key decoder (root)
  7. REM BKYCOD%  black key decoder (root)
  8. REM WHCOD% white key decoder for keyboard
  9. REM BLCOD% black key decoder for keyboard
  10. DIM bbr%(5),wkycod%(7),bkycod%(7)
  11. DIM whcod%(30),blcod%(25)
  12. DIM kntps%(52),flps%(22),shps%(22)
  13. DIM kylets$(13),kyletb$(13)
  14. DIM sprite$(24)
  15. DIM x1%(50),x2%(50),y1%(50),y2%(50) ! for mouse sensitive zones
  16. DIM note_response%(50,3),samp_size%(50),av_response%(50)
  17. DIM accidentals$(3),staff$(3),mode$(3),scale$(4),keep_stat$(2)
  18. DIM permuted_notes%(100)
  19. REM if usesharps% = 1 then sharps are used instead of flats
  20. rez%=XBIOS(4)
  21. IF rez%<>1
  22.   ALERT 3," Please switch to | medium resolution! ",1,"Oops",b%
  23.   STOP
  24. ENDIF
  25. DEFMOUSE 3
  26. accid%=0
  27. staff%=0
  28. mode%=0
  29. lont%=50
  30. rnt%=15
  31. wb%=180
  32. config%=0
  33. pass_resp%=30
  34. notes_left%=0
  35. lesson_num%=1
  36. keep_stat%=0
  37. note_range%=8
  38. @initialize_arrays
  39. @clear_response
  40. @load_response
  41. FOR i%=1 TO 1000
  42.   @select_parameters
  43. NEXT i%
  44. > PROCEDURE show_parameter(num%)
  45.   LOCAL k%
  46.   SELECT num%
  47.   CASE 0
  48.     TEXT 25,10,"Instructions"
  49.   CASE 1
  50.     TEXT 25,20,"Accidentals"
  51.     TEXT 120,20,SPACE$(8)
  52.     TEXT 120,20,accidentals$(accid%)
  53.   CASE 2
  54.     TEXT 25,30,"Staff"
  55.     TEXT 120,30,SPACE$(8)
  56.     TEXT 120,30,staff$(staff%)
  57.   CASE 3
  58.     TEXT 25,40,"Mode"
  59.     TEXT 120,40,SPACE$(16)
  60.     TEXT 120,40,mode$(mode%)
  61.   CASE 4
  62.     TEXT 25,50,""
  63.   CASE 5
  64.     TEXT 25,60,"Start"
  65.   CASE 6
  66.     TEXT 25,70,"Quit"
  67.   CASE 7
  68.     TEXT 25,80,"Show score"
  69.   CASE 8
  70.     IF mode%=1
  71.       TEXT 25,90,"Lesson"
  72.       TEXT 80,90,SPACE$(30)
  73.       TEXT 80,90,STR$(lesson_num%)
  74.       @set_range_for_lesson
  75.       k%=(lont%-25) DIV 12
  76.       j%=MOD(lont%,12)
  77.       TEXT 100,90,"from "+scale$(k%)+" "+kylets$(j%)
  78.       k%=(lont%+rnt%-29) DIV 12
  79.       j%=MOD(lont%+rnt%,12)
  80.       TEXT 215,90,"to "+scale$(k%)+" "+kylets$(j%)
  81.     ENDIF
  82.   CASE 9
  83.     IF config%=1
  84.       TEXT 25,100,"Save on exit"
  85.       TEXT 130,100,SPACE$(4)
  86.       TEXT 130,100,keep_stat$(keep_stat%)
  87.     ENDIF
  88.   CASE 10
  89.     IF config%=1
  90.       TEXT 25,110,"Clear score"
  91.     ENDIF
  92.   CASE 11
  93.     IF config%=1
  94.       TEXT 25,120,"Passing grade"
  95.       TEXT 140,120,SPACE$(4)
  96.       TEXT 140,120,STR$(pass_resp%)
  97.     ENDIF
  98.   CASE 12
  99.     IF config%=1
  100.       TEXT 25,130,"Note range"
  101.       TEXT 140,130,SPACE$(4)
  102.       TEXT 140,130,STR$(note_range%)
  103.     ENDIF
  104.   CASE 14
  105.     IF config%=1
  106.       TEXT 25,150,"Configuration done"
  107.     ENDIF
  108.   ENDSELECT
  109. RETURN
  110. > PROCEDURE show_all_parameters
  111.   LOCAL i%,n%
  112.   CLS
  113.   DEFTEXT 1,0
  114.   IF mode%=1
  115.     n%=11
  116.   ELSE
  117.     n%=9
  118.   ENDIF
  119.   IF config%=1
  120.     n%=14
  121.   ENDIF
  122.   FOR i%=0 TO n%
  123.     @show_parameter(i%)
  124.   NEXT i%
  125. RETURN
  126. > PROCEDURE select_parameters
  127.   LOCAL choice%,highlight%,i%
  128.   DEFFILL 0
  129.   PBOX 0,0,319,199
  130.   highlight%=0
  131.   @show_all_parameters
  132.   REPEAT
  133.     REPEAT
  134.       choice%=MOUSEY/10
  135.       key$=INKEY$
  136.       IF highlight%<>choice%
  137.         DEFTEXT 1,0
  138.         show_parameter(highlight%)
  139.         DEFTEXT 1,1
  140.         show_parameter(choice%)
  141.         highlight%=choice%
  142.       ENDIF
  143.     UNTIL MOUSEK<>0 OR key$="c"
  144.     IF MOUSEK=1 OR MOUSEK=2
  145.       modify_parameter(choice%)
  146.     ENDIF
  147.     IF key$="c"
  148.       config%=1
  149.       @show_all_parameters
  150.       FOR i%=0 TO 10
  151.         key$=INKEY$
  152.       NEXT i%
  153.     ENDIF
  154.     show_parameter(choice%)
  155.     PAUSE 20
  156.     DEFTEXT 1,0
  157.   UNTIL choice%=15
  158. RETURN
  159. > PROCEDURE modify_parameter(num%)
  160.   SELECT num%
  161.   CASE 0
  162.     @instructions
  163.   CASE 1
  164.     accid%=MOD(accid%+1,3)
  165.     IF accid%=0
  166.       accidentals%=0
  167.     ENDIF
  168.     IF accid%=1
  169.       accidentals%=1
  170.       usesharps%=0
  171.     ENDIF
  172.     IF accid%=2
  173.       accidentals%=1
  174.       usesharps%=1
  175.     ENDIF
  176.   CASE 2
  177.     staff%=MOD(staff%+1,3)
  178.     IF staff%=0
  179.       lesson_num%=5
  180.     ELSE
  181.       lesson_num%=1
  182.     ENDIF
  183.     IF mode%=1
  184.       show_parameter(8)
  185.     ENDIF
  186.   CASE 3
  187.     mode%=MOD(mode%+1,3)
  188.     IF mode%=1
  189.       show_parameter(8)
  190.     ENDIF
  191.   CASE 4
  192.   CASE 5
  193.     @display_staff_board
  194.     IF mode%=1
  195.       @set_range_for_lesson
  196.     ELSE IF mode%=0
  197.       IF staff%=1
  198.         lont%=30
  199.         rnt%=20
  200.       ELSE IF staff%=0
  201.         lont%=50
  202.         rnt%=27
  203.       ELSE
  204.         lont%=30
  205.         rnt%=47
  206.       ENDIF
  207.       lx1%=@x_from_note(lont%)-10
  208.       lx2%=@x_from_note(lont%+rnt%)+8
  209.     ELSE
  210.       @select_range
  211.     ENDIF
  212.     @exercise
  213.   CASE 6
  214.     IF keep_stat%=0
  215.       @save_response
  216.     ENDIF
  217.     END
  218.   CASE 7
  219.     @compute_avg_response
  220.     @show_score
  221.   CASE 8
  222.     IF mode%=1
  223.       INC lesson_num%
  224.       IF lesson_num%>10
  225.         IF staff%=0
  226.           lesson_num%=5
  227.         ELSE
  228.           lesson_num%=1
  229.         ENDIF
  230.       ENDIF
  231.     ENDIF
  232.   CASE 9
  233.     IF config%=1
  234.       keep_stat%=MOD(keep_stat%+1,2)
  235.       PRINT keep_stat%
  236.     ENDIF
  237.   CASE 10
  238.     IF config%=1
  239.       @clear_response
  240.       TEXT 120,110,"done"
  241.     ENDIF
  242.   CASE 11
  243.     IF config%=1
  244.       pass_resp%=MOD(pass_resp%,50)+5
  245.     ENDIF
  246.   CASE 12
  247.     IF config%=1
  248.       note_range%=MOD(note_range%,20)+2
  249.     ENDIF
  250.   CASE 14
  251.     IF config%=1
  252.       config%=0
  253.       @show_all_parameters
  254.     ENDIF
  255.   ENDSELECT
  256. RETURN
  257. '
  258. > PROCEDURE initialize_arrays
  259.   @load_note_sprites
  260.   @read_black_keys
  261.   @read_key_decoders
  262.   @read_note_positions
  263.   @read_key_to_letter_converter
  264.   @read_option_strings
  265. RETURN
  266. > PROCEDURE display_staff_board
  267.   shfty%=40
  268.   CLS
  269.   DEFMOUSE 0
  270.   @draw_treble_bass_staff
  271.   @draw_keyboard
  272.   @draw_black_keys
  273. RETURN
  274. > PROCEDURE setup
  275.   @select_range
  276. RETURN
  277. > PROCEDURE load_note_sprites
  278.   OPEN "i",#1,"notes2.put"
  279.   FOR loop=1 TO 23
  280.     sprite$(loop)=INPUT$(CVI(INPUT$(2,#1)),#1)
  281.   NEXT loop
  282.   CLOSE #1
  283. RETURN
  284. > PROCEDURE draw_treble_bass_staff
  285.   DEFFILL 0
  286.   PBOX 5,10+shfty%,625,90+shfty%
  287.   COLOR 1
  288.   FOR i=1 TO 5
  289.     LINE 5,20+i*5+shfty%,625,20+i*5+shfty%
  290.     LINE 5,55+i*5+shfty%,625,55+i*5+shfty%
  291.   NEXT i
  292.   PUT 10,25+shfty%,sprite$(1),7
  293.   PUT 10,60+shfty%,sprite$(2),7
  294.   lstnte%=73
  295.   xp%=55
  296. RETURN
  297. > PROCEDURE draw_keyboard
  298.   wb%=180
  299.   wt%=180-40
  300.   REM draw white keys
  301.   FOR i%=0 TO 28
  302.     BOX i%*20,wb%,i%*20+18,wt%
  303.   NEXT i%
  304. RETURN
  305. > PROCEDURE read_black_keys
  306.   FOR i%=1 TO 5
  307.     READ bbr%(i%)
  308.   NEXT i%
  309.   DATA 13,35,57,93,117
  310. RETURN
  311. > PROCEDURE draw_black_keys
  312.   LOCAL j%,k%
  313.   DEFFILL 1
  314.   wb%=wb%-13
  315.   k%=1
  316.   REM draw black keys. The black keys are also zoned.
  317.   DEFFILL 1,1
  318.   FOR j%=0 TO 3
  319.     FOR i%=1 TO 5
  320.       PBOX bbr%(i%)+140*j%,wb%,bbr%(i%)+140*j%+10,wt%
  321.       set_zone(k%,bbr%(i%)+140*j%,wt%,bbr%(i%)+140*j%+10,wb%)
  322.       k%=k%+1
  323.     NEXT i%
  324.   NEXT j%
  325.   wb%=wb%+13
  326.   number_of_zones%=k%-1
  327. RETURN
  328. > PROCEDURE read_key_decoders
  329.   REM The decoders convert the key press to the note to be sounded.
  330.   FOR i%=1 TO 7
  331.     READ wkycod%(i%)
  332.   NEXT i%
  333.   FOR i%=1 TO 5
  334.     READ bkycod%(i%)
  335.   NEXT i%
  336.   k%=0
  337.   FOR j%=0 TO 3
  338.     FOR i%=1 TO 7
  339.       whcod%(k%)=wkycod%(i%)+30+j%*12
  340.       k%=k%+1
  341.     NEXT i%
  342.   NEXT j%
  343.   whcod%(28)=78
  344.   k%=1
  345.   FOR j%=0 TO 3
  346.     FOR i%=1 TO 5
  347.       blcod%(k%)=bkycod%(i%)+30+12*j%
  348.       k%=k%+1
  349.     NEXT i%
  350.   NEXT j%
  351.   DATA 0,2,4,6,7,9,11
  352.   DATA 1,3,5,8,10
  353. RETURN
  354. > PROCEDURE read_note_positions
  355.   REM read the vertical position to display the note sprites on
  356.   REM the treble or bass staff.
  357.   REM negative numbers are pointers to sharp or flat notes.
  358.   REM FLPS are the flat note positions
  359.   REM SHPS are the sharp note positions.
  360.   FOR i%=1 TO 49
  361.     READ kntps%(i%)
  362.   NEXT i%
  363.   FOR i%=1 TO 21
  364.     READ flps%(i%)
  365.   NEXT i%
  366.   FOR i%=1 TO 20
  367.     READ shps%(i%)
  368.   NEXT i%
  369.   DATA 67,-1,65,-2,62,-3,60,58,-4,55
  370.   DATA -5,63,61,-6,59,-7,56,-8,54,52
  371.   DATA -9,32,-10,30,28,-11,25,-12,23,-13
  372.   DATA 20,28,-14,26,-15,23,21,-16,19,-17
  373.   DATA 17,-18,15,13,-19,11,-20,9,-21
  374.   REM
  375.   DATA 65,62,60,55,63,59,57,54,32,30
  376.   DATA 25,23,20,26,23,19,17,15,11,9
  377.   DATA 7
  378.   REM
  379.   DATA 67,65,62,58,55,61,59,56,52,32
  380.   DATA 28,25,23,28,26,21,19,17,13,11
  381. RETURN
  382. > PROCEDURE read_key_to_letter_converter
  383.   REM  First sharps